;;########################################################################
;; mmrvis1.lsp
;; visualization for multivariate multiple regression ViSta model object
;; new visualization written by Forrest W. Young Oct-Dec 1997
;; Copyright (c) 1999 by Forrest W. Young
;;########################################################################

(defmeth mmr-model-object-proto :visualize ()
  (if (not (eq current-object self)) (setcm self))
  (when (= 1 (send self :num-iv))
        (error "Visualization not possible when there is only one predictor. Use REGRES (Univariate Regression) rather than MULREG (Multivariate Regression)."))
  (let* ((mmr-model self)
         (cpoints (center (select (send self :data-matrix)
                                  (iseq (send self :nobs))
                                  (send self :iv))))
         (nobs (send self :nobs))
         (num-iv (send self :num-iv))
         (spin-dim num-iv)
         (npts nil)
         (mmrmod self)
         (rays (transpose (send self :beta)));(rays (send self :coefs))
         (nredun (send self :redundancy))
         (redun-rays (if nredun
          (matmult 
           (diagonal  (select (send self :redun-evals) (iseq nredun)))
           (transpose (select (send self :redun-coefs)
                              (iseq num-iv) (iseq nredun))))))
         (scaled-coefs (select (column-list rays) (iseq spin-dim)))
         (dimension-lengths nil)
         (scaled-coefs-mat nil)
         (vector-lengths nil)
         (spin-vector-ratio nil)
         (redlabels nil)
         (denom-redun nil)
         (scale-factor-redun nil)
         (scaled-redun-coefs nil)
         (ray-labels (select (send self :variables) (send self :dv)))
         (variables (column-list cpoints))
         (scale-type 'fixed)
         (point-labels (send self :labels))
         (residuals (send (select (send self :reg-models) 0) :residuals))
         (cooks (send (select (send self :reg-models) 0) :cooks-distances))
         (leverages (send (select (send self :reg-models) 0) :leverages))
         (y-hat (col (send self :scores) 0))
         (variable-labels (select (send self :variables) (send self :iv)))
         (scatter nil)
         (cutoff 7)
         (var-list (when (> num-iv cutoff)
                         (name-list variable-labels :show nil 
                                    :title "Predictor Variables" :menu nil)))
         (scatmat (when (<= num-iv cutoff)
                        (scatterplot-matrix variables :show nil
                            :scale-type nil :point-labels point-labels
                            :variable-labels variable-labels
                            :title "Predictor ScatMat")))
         (spin-plot
          (if (> num-iv 2)
              (spin-plot  variables :show nil 
                          :scale-type 'variable
                          :point-labels point-labels
                          :variable-labels variable-labels
                          :title "Predictor Spin BiPlot")
              (plot-points variables :show nil
                            :scale-type 'centroid-variable
                            :point-labels point-labels
                            :variable-labels variable-labels
                            :title "Predictor BiPlot")))
         (influence-plot 
          (plot-points y-hat cooks :show nil :title "Response Influence Plot"))
         (list-obs (name-list point-labels :show nil 
                              :title "Point and Vector Labels" ))
         (reg-plot 
          (plot-points (list 1 2) (list 1 2) :show nil 
                       :title "Response Fit Plot"))
         (resid-plot 
          (plot-points y-hat residuals :show nil 
                       :title "Response Residuals Plot"))
         (plot-cells (list (if (> num-iv cutoff) var-list scatmat) 
                           spin-plot influence-plot
                           list-obs reg-plot  resid-plot))
         (sp (spread-plot (matrix '(2 3) plot-cells)))
         )

    (send self :visualization-help sp spin-plot influence-plot 
          reg-plot resid-plot redun-rays)

    (send influence-plot :add-slot 'switch 1)

    (defmeth influence-plot :adjust-screen-point (i)
            (let* ((npoints (send self :num-points)))
              (send self :slot-value 'switch 
                    (* -1 (send self :slot-value 'switch)))
              (cond
                ((> npoints i) (call-next-method i))
                (t 
                 (when (and (< i (+ npoints (send mmr-model :num-dv)))
                            (> 0 (send self :slot-value 'switch)))
                       (send self :plot-details mmr-model (- i npoints) ))
                 ))))

    (defmeth influence-plot :plot-details (mob i) 
      (let* ((cooks 
              (send (select (send mob :reg-models) i) :cooks-distances))
             (y-hat (col (send mob :scores) i))
             (minx (min y-hat))
             (maxx (max y-hat))
             (miny (min cooks))
             (maxy (max cooks))
             (gnrx (get-nice-range minx maxx 5))
             (gnry (get-nice-range miny maxy 5))
             )
        (send self :range 0 (first gnrx) (second gnrx) :draw nil)
        (send self :range 1 (first gnry) (second gnry) :draw nil)
        (send self :x-axis t t (third gnrx) :draw nil)
        (send self :y-axis t t (third gnry) :draw nil)
        (send self :clear-points)
        (send self :add-points y-hat cooks
              :point-labels (send mob :labels) :draw nil)
        #+color(send self :use-color t)
        #+color(send self :point-color 
                     (iseq (send self :num-points)) 'blue)
        (send self :point-symbol
              (iseq (send self :num-points)) 'square)
        (send self :variable-label 0 
              (strcat "Predicted " 
                      (select (select (send mob :variables) 
                                      (send mob :dv)) i)))
        (send self :variable-label 1 "Cook's Distances")
        (send self :redraw)))
    
    (send influence-plot :plot-details self 0)
    (send influence-plot :plot-buttons :new-x nil :new-y nil)
    (send influence-plot :showing-labels t)
    (send influence-plot :linked t)
    (send influence-plot :mouse-mode 'brushing)
    (send resid-plot :add-slot 'switch 1)
   
    (defmeth resid-plot :adjust-screen-point (i)
            (let* ((npoints (send self :num-points)))
              (send self :slot-value 'switch 
                    (* -1 (send self :slot-value 'switch)))
              (cond
                ((> npoints i) (call-next-method i))
                (t 
                 (when (and (< i (+ npoints (send mmr-model :num-dv)))
                            (> 0 (send self :slot-value 'switch)))
                       (send self :plot-details mmr-model (- i npoints) ))
                 ))))

    (defmeth resid-plot :plot-details (mob i) 
      (let* (
             (residuals (send (select (send mob :reg-models) i) :residuals))
             (y-hat (col (send mob :scores) i))
             (minx (min y-hat))
             (maxx (max y-hat))
             (maxy (max (abs residuals)))
             (miny (- maxy))
             (gnrx (get-nice-range minx maxx 5))
             (gnry (get-nice-range miny maxy 5))
             )
        (send self :range 0 (first gnrx) (second gnrx) :draw nil)
        (send self :range 1 (first gnry) (second gnry) :draw nil)
        (send self :x-axis t t (third gnrx) :draw nil)
        (send self :y-axis t t (third gnry) :draw nil)
        (send self :clear-points)
        (send self :add-points y-hat residuals
              :point-labels (send mob :labels) :draw nil)
        #+color(send self :use-color t)
        #+color(send self :point-color 
                     (iseq (send self :num-points)) 'blue)
        (send self :point-symbol
          (iseq (send self :num-points)) 'square)
        (send self :variable-label 0 
              (strcat "Predicted " 
                      (select (select (send mob :variables) 
                                      (send mob :dv)) i)))
        (send self :variable-label 1 "Residuals")
        (send self :abline 0 0)
        (send self :redraw)))
    
    (send resid-plot :plot-details self 0)
    (send resid-plot :plot-buttons :new-x nil :new-y nil)
    (send resid-plot :showing-labels t)
    (send resid-plot :linked t)
    (send resid-plot :mouse-mode 'brushing)

  

;scatmat methods and details
    (when scatmat
          (send scatmat :add-mouse-mode 'focus-on-variables
                :title "Focus On Variables"
                :click :do-new-variable-focus
                :cursor 'finger)
          (send scatmat :mouse-mode 'focus-on-variables)
          (send scatmat :plot-buttons :new-x nil :new-y nil)
          #+color(send scatmat :use-color t)
          #+color(send scatmat :point-color 
                       (iseq (send scatmat :num-points)) 'blue)
          (send scatmat :point-symbol
                (iseq (send scatmat :num-points)) 'square)
          (send scatmat :linked t))

;var-list methods and details
    (when var-list
          (send var-list :fix-name-list)
          ;(send var-list :has-h-scroll (max (screen-size)))
          ;(send var-list :has-v-scroll (max (screen-size)))
          (send var-list :redraw)
          (send var-list :menu nil)
          (defmeth var-list :do-select-click (x y m1 m2)
            (call-next-method x y m1 m2)
            (let* ((cur-var  (send self :selection))
                   (nvar nil) (variable-labels nil)
                   (var-labs nil) (cur-data nil) )
              (when cur-var
                    (setf nvar (send self :num-points))
                    (setf variable-labels 
                          (send self :point-label (iseq nvar)))
                    (setf var-labs (select variable-labels cur-var))
                    (setf cur-data 
                          (map-elements #'send current-data 
                                        :variable var-labs))
                    (send sp :update-spreadplot 0 0  cur-var 
                          (list var-labs cur-data)))
              ))
          )

;spin-plot and scatterplot methods and details
    (setf scatter spin-plot)
    (send spin-plot :scale-type 'centroid-variable)
    (send spin-plot :linked t)
    (send spin-plot :showing-labels t)
  ;  #+color(send scatter :use-color t)
    #+color(send spin-plot :point-color 
                 (iseq (send spin-plot :num-points)) 'blue)
    (when (> num-iv 2) (send spin-plot :depth-cuing nil))
    (send spin-plot   :point-symbol
          (iseq (send spin-plot :num-points)) 'square)
    (setf dimension-lengths 
          (mapcar #'second (send spin-plot :range (iseq spin-dim))))
    (setf scaled-coefs-mat 
          (matrix (list spin-dim (send self :num-dv)) 
                  (combine scaled-coefs)))
    (setf vector-lengths
          (sqrt (mapcar #'ssq (column-list scaled-coefs-mat))))
    (setf spin-vector-ratio (/ (min dimension-lengths) 
                               (max vector-lengths)))
    (setf scaled-coefs (* scaled-coefs spin-vector-ratio))
    
    (send spin-plot   :add-rays scaled-coefs 
          :ray-labels ray-labels :ray-color 'green)
    (when redun-rays
          (setf redlabels
                (mapcar #'(lambda (x) (format nil "Red~d" x))
                        (iseq nredun)))
          (setf scaled-redun-coefs (* redun-rays spin-vector-ratio))
          (setf scaled-coefs-mat 
                (matrix (list spin-dim nredun) (combine scaled-redun-coefs)))
          (setf vector-lengths
                (sqrt (mapcar #'ssq (column-list scaled-coefs-mat))))
          (setf spin-vector-ratio (/ (min dimension-lengths) 
                                     (max vector-lengths)))
          (setf scaled-redun-coefs 
                (* scaled-redun-coefs spin-vector-ratio))
          (send spin-plot :add-rays (column-list scaled-redun-coefs) 
                :ray-labels redlabels :ray-color 'red)
          (send spin-plot :add-rays (column-list (* -1 scaled-redun-coefs)) 
                :ray-labels redlabels :ray-color 'red))

;spin-plot unique methods and details

    (cond 
      ((> num-iv 2)
       (send spin-plot :plot-buttons :margin nil :box t :new-x nil :new-y nil)
       (defmeth spin-plot :update-plotcell (i j args)
         (when (and (= i 0) (= j 0))
            (let* ((cur-var-nums (remove-duplicates (first args)))
                   (cur-var-names (remove-duplicates 
                                   (first (second args))  :test 'equal))
                   (numvars (send self :num-variables))
                   )
              (when (<= (length cur-var-nums) 2)
                    (setf cur-var-nums 
                          (select 
                           (combine cur-var-nums 
                            (set-difference (send self :current-variables)
                                            cur-var-nums))
                           (iseq 3)))
                    (setf cur-var-names 
                          (select (send self :variable-labels)
                                  cur-var-nums)))
              (when (or (= (length cur-var-nums) 3)
                        (and (= (length cur-var-nums) 4)
                             (= (third (send self :current-variables)) 
                                (- numvars 1))))
                    (when (= (length cur-var-nums) 4)
                          (setf cur-var-nums (select cur-var-nums '(0 1 2)))
                          (setf cur-var-names 
                                (select cur-var-names '(0 1 2)))
                          )
                    (apply #'send self  :current-variables cur-var-nums)
                    (send self :set-variables-with-labels cur-var-nums
                          cur-var-names)
                    (send self :transformation nil :draw nil)
                    (send self :add-box)
                    (when (matrixp (send self :slot-value 'rotation-type))
                          (send self :slot-value 'rotation-type 'yawing))
                    (send self :redraw)
                    ))))
       
       (send spin-plot :menu-template 
             '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH 
                              SYMBOL COLOR line-width DASH FASTER SLOWER AXES))
       (send spin-plot :new-menu)
       (send spin-plot :mouse-mode 'hand-rotate)
       
    ;   (send spin-plot :set-variables-with-labels '(0 1 2)
    ;         (select (send spin-plot :variable-labels) '(0 1 2))) 
       
       (defmeth spin-plot :add-box (&key (draw t))
         (call-next-method)
         (send spin-plot :add-rays scaled-coefs) 
         (when redun-rays
               (send spin-plot :add-rays (column-list scaled-redun-coefs) 
                     :ray-labels redlabels :ray-color 'red)
               (send spin-plot :add-rays 
                     (column-list (* -1 scaled-redun-coefs))
                     :ray-labels redlabels :ray-color 'red))
         (send self :redraw-content) )
   
       (defmeth spin-plot :set-line-width ()
         (let* ((box? (send self :show-box))
                )
           (send self :ray-line-width 
                 (first (get-value-dialog "Specify Ray Line Width" 
                                          :initial (send self :ray-line-width))))
           (cond
             (box? 
              (send self :clear-lines :draw nil)
              (send self :add-box :draw t))
             (t
              (send self :clear-lines :draw nil)
              (send self :add-rays scaled-coefs :ray-labels ray-labels)
              (when scaled-redun-coefs
                    (send self :add-rays (column-list scaled-redun-coefs)
                          :ray-labels redlabels :ray-color 'red)
                    (send self :add-rays (column-list (* -1 scaled-redun-coefs))
                          :ray-labels redlabels :ray-color 'red))))
           ))
       (defmeth spin-plot :add-rays (rays &key ray-labels (ray-color 'green))
         (call-next-method rays :ray-labels ray-labels :ray-color ray-color)
         )
       (send spin-plot :switch-add-box)   
       )
      (t

;scatterplot methods and details

       (send scatter :plot-buttons :new-x nil :new-y nil)

       (defmeth scatter :redraw ()
         (call-next-method)
         (send self :add-grid))
       
       (defmeth scatter :plot-details () 
         (let* ((x (send self :point-coordinate 0 (iseq nobs)))
                (y (send self :point-coordinate 1 (iseq nobs)))
                (maxx (max (abs x)))
                (minx (- maxx))
                (maxy (max (abs y)))
                (miny (- maxy))
                (gnrx (get-nice-range minx maxx 5))
                (gnry (get-nice-range miny maxy 5))
                (minaxx (first  gnrx))
                (maxaxx (second gnrx))
                (minaxy (first  gnry))
                (maxaxy (second gnry))
                )
           (send self :range 0 minaxx maxaxx :draw nil)
           (send self :range 1 minaxy maxaxy :draw nil)
           (send self :x-axis t t (third gnrx) :draw nil)
           (send self :y-axis t t (third gnry) :draw nil)
           (send self :add-grid)
           (send self :redraw)
           ))

       (send scatter :plot-details)
       (send scatter :menu-template 
             '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH SYMBOL COLOR line-width))
       (send scatter :new-menu)
       ))

;reg-plot methods and details          
        
    (send reg-plot :add-slot 'switch 1)
    
    (defmeth reg-plot :reg-plot (i mob) 
      (let* ((x (send (select (send mob :reg-models) i) :y))
             (y (col (send mob :scores) i))
             (min (min (combine x y)))
             (max (max (combine x y)))
             (gnr (get-nice-range min max 5))
             (axmin (first gnr))
             (axmax (second gnr))
             )
        (send self :range 0 (first gnr) (second gnr) :draw nil)
        (send self :range 1 (first gnr) (second gnr) :draw nil)
        (send self :x-axis t t (third gnr) :draw nil)
        (send self :y-axis t t (third gnr) :draw nil)
        
        (send self :clear)
        (send self :add-points x y 
              :point-labels (send mob :labels) :draw nil)
        #+color(send self :use-color t)
        #+color(send self :point-color 
                     (iseq (send self :num-points)) 'blue)
        (send self :point-symbol
              (iseq (send self :num-points)) 'square)
        (send self :variable-label 0
              (select (select (send mob :variables) 
                              (send mob :dv)) i))
        (send self :variable-label 1 
              (strcat "Predicted " 
                      (select (select (send mob :variables) 
                                      (send mob :dv)) i)))
        (send self :add-lines 
              (list (list axmin axmax) (list axmin axmax)) :draw nil)
        (send self :redraw)))
    
    (defmeth reg-plot :adjust-screen-point (i)
      (let* ((npoints (send self :num-points)))
        (send self :slot-value 'switch 
              (* -1 (send self :slot-value 'switch)))
        (cond
          ((> npoints i) (call-next-method i))
          (t 
           (when (and (< i (+ npoints (send mmr-model :num-dv)))
                      (> 0 (send self :slot-value 'switch)))
                 (send self :reg-plot (- i npoints) mmr-model))
           ))))
    (send reg-plot :reg-plot 0 self)
    (send reg-plot :showing-labels t)
    (send reg-plot :linked t)
    (send reg-plot :mouse-mode 'brushing)
    
    (send reg-plot :plot-buttons :new-x nil :new-y nil)
    
    
;list-obs methods and details
    (send list-obs  :linked t)
    #+color(send list-obs :use-color t)
    #+color(send list-obs :point-color (iseq nobs) 'blue)
    (send list-obs :add-points (send self :num-dv) 
          :point-labels ray-labels)
    (send list-obs :point-color 
          (iseq nobs (+ nobs (- (send self :num-dv) 1))) 'green)
    (when redun-rays
          (setf npts (send list-obs :num-points))
          (send list-obs :add-points (send self :redundancy)
                :point-labels redlabels)
          (send list-obs :point-color 
                      (iseq npts 
                            (+ npts (- (send self :redundancy) 1))) 'red))
    (send list-obs :fix-name-list)
    
    
   ; (send (send scatter :menu) :title "BiPlot")
   ; (send (send spin-plot :menu) :title "SpinBiPlot")
   ; (send (send influence-plot :menu) :title "Influence")
   ; (send (send resid-plot :menu) :title "Residuals")
   ; (send (send reg-plot :menu) :title "FitPlot")
   ; (send (send list-obs :menu) :title "Labels")
    (send sp :show-spreadplot)
    t))
